home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 August: Tool Chest / Dev.CD Aug 94.toast / Tool Chest / Networking & Communications / MacTCP / MacTCP Developer Tools / HyperCard MacTCP Toolkit 1.0 / Source Code ƒ / TCPSend.p < prev    next >
Encoding:
Text File  |  1993-06-15  |  2.3 KB  |  98 lines  |  [TEXT/MPS ]
  1. (*
  2.     TCPSend connectionID,string -- Send a string to the TCP connection.
  3.         Note: It would be a good idea to add an optional third parameter, which, if present, would cause
  4.         linefeeds to be appended to all carriage returns. This would make it much easier and faster to
  5.         send HyperCard text and CRLF line terminations.
  6.  
  7.     To compile and link this file using Macintosh Programmer's Workshop,
  8.  
  9.         pascal -w TCPSend.p
  10.         link -m ENTRYPOINT -o HyperCommands -rt XCMD=7861 -sn Main=TCPSend ∂
  11.             TCPSend.p.o "{Libraries}HyperXLib.o" "{MPW}"Libraries:interface.o
  12.  
  13.     © Copyright 1988 by Apple Computer, Inc.
  14.  
  15.     Initial coding 12/88 by Harry R. Chesley.
  16. *)
  17.  
  18. {$R-}
  19.  
  20. {$S TCPSend }     { Segment name must be the same as the command name. }
  21.  
  22. unit DummyUnit;
  23.  
  24. interface
  25.  
  26. uses MemTypes, QuickDraw, OSIntf, HyperXCmd;
  27.  
  28. procedure EntryPoint(paramPtr: XCmdPtr);
  29.     
  30. implementation
  31.  
  32. procedure TCPSend(paramPtr: XCmdPtr); forward;
  33.  
  34. procedure EntryPoint(paramPtr: XCmdPtr);
  35.  
  36.     begin
  37.         TCPSend(paramPtr);
  38.     end;
  39.  
  40. procedure TCPSend(paramPtr: XCmdPtr);
  41.  
  42.     type
  43.  
  44.     wdsType =                        { Write block for TCP driver. }
  45.         record
  46.             size: integer;                { Number of bytes. }
  47.             buffer: Ptr;                    { Pointer to bytes. }
  48.             term: integer;                { Zero for end of blocks. }
  49.         end;
  50.  
  51.     var wds: wdsType;
  52.  
  53.     procedure Fail(errMsg: Str255); { set theResult and quit }
  54.         begin
  55.             paramPtr^.returnValue := PasToZero(paramPtr,errMsg);
  56.             exit(TCPSend);
  57.         end;
  58.  
  59.     {$I TCPUtil.inc}
  60.  
  61.     function countString(sPtr: Ptr): longInt;
  62.         { Return the number of characters in the zero-terminated string pointed to by sPtr.
  63.             Note: This should be replaced by a HyperCard callback. }
  64.  
  65.         var count: longInt;
  66.  
  67.         begin
  68.             count := 0;
  69.             while sPtr^ <> 0 do
  70.                 begin
  71.                     count := count+1;
  72.                     sPtr := Ptr(ord4(sPtr)+1);
  73.                 end;
  74.             countString := count;
  75.         end;
  76.  
  77.     begin
  78.         if paramPtr^.paramCount <> 2 then Fail('§§§ parameter count is not 2 §§§');
  79.  
  80.         SetUpConnectionID;
  81.  
  82.         { Check for an empty string being sent. }
  83.         if paramPtr^.params[2] = nil then exit(TCPSend);
  84.         if paramPtr^.params[2]^^ = 0 then exit(TCPSend);
  85.  
  86.         { Issue the TCP write. }
  87.         HLock(paramPtr^.params[2]);
  88.         wds.buffer := paramPtr^.params[2]^;
  89.         wds.size := countString(wds.buffer);
  90.         wds.term := 0;
  91.         ZeroIOParms;
  92.         SyncControlBlock.csCode := TCPcsSend;
  93.         PutControlLongAtOffset(ord4(@wds),38);
  94.         if PBControl(@SyncControlBlock,false) <> noErr then Fail('§§§ send failed §§§');
  95.     end;
  96.  
  97. end.
  98.